SEARCH STENEX,PROLOG
	TITLE TOPS
	SEARCH MONSYM,MACSYM
	SWAPCD

	EXTERN TTFORK,SETUNT,CPYFUS,MAXLC,DIRLUK,CPYTUS,GETDDB,USTDIR,RELFRE
	EXTERN BUGHLT,CAPMSK,JOBNAM,JOBNM2,MRETNE,MRTNE1,SNAMES,JOBRT,JOBPT
	EXTERN JOBDIR,BHC,ACCCHK,ASGJFR,CAPENB,CHKJFN,DIRCHK,DSKDTB,GETFDB
	EXTERN MAXLW,CPYFUS,ITRAP1,UNLCKF,GDIRST

;FLAGS IN KEYWORD TABLE (FIRST WORD OF STRING IF B0-6 = 0)

CM%INV==:1B35			;INVISIBLE
CM%NOR==:1B34			;NO-RECOGNIZE (PLACE HOLDER)
CM%ABR==:1B33			;ABBREVIATION
CM%FW==:1B7			;FLAG WORD (ALWAYS SET)


;LOCAL ROUTINE TO SETUP BYTE PTR TO TABLE STRING AND GET FLAGS
; T2/ ADDRESS OF STRING
;	CALL CHKTBS
; T1/ FLAGS
; T2/ BYTE POINTER TO STRING

CHKTBS:	XCTUM [SKIPE T1,0(T2)]	;CHECK FIRST WORD OF STRING
	TXNE T1,177B6		;FIRST CHAR 0 AND WORD NOT ALL-0?
	TDZA T1,T1		;NO, MAKE FLAGS ALL 0
	AOS T2			;YES, HAVE FLAGS, ADJUST BYTE PTR
	HRLI T2,(POINT 7,0)	;SETUP P AND S FIELDS
	RET

;STRING COMPARE JSYS
; T1/ TEST STRING POINTER
; T2/ BASE STRING POINTER
;	STCMP
; RETURNS +1 ALWAYS,
;  T1/ COMPARE CODE:
;	1B0 (SC%LSS) - TEST STRING LESS THAN BASE STRING
;	1B1 (SC%SUB) - TEST STRING SUBSET OF BASE STRING
;	1B2 (SC%GTR) - TEST STRING GREATER THAN BASE STRING
;	N.O.T.A. MEANS EXACT MATCH
;  T2/ UPDATED BASE STRING POINTER, USEFUL IN CASE TEST STRING
;	WAS SUBSET

.STCMP::MCENT
	HLRZ T3,T1
	CAIN T3,-1
	HRLI T1,(POINT 7,0)
	HLRZ T3,T2
	CAIN T3,-1
	HRLI T2,(POINT 7,0)
	CALL USTCMP		;DO THE WORK
	UMOVEM T1,T1		;RETURN THE RESULT
	UMOVEM T2,T2
	MRETNG

;STRING COMPARE ROUTINE - REFERENCES PREVIOUS CONTEXT.
; T1/ TEST STRING POINTER
; T2/ BASE STRING POINTER
;	CALL USTCMP
;RETURN AS FOR .STCMP

USTCMP::XCTBU [ILDB T3,T1]	;GET NEXT BYTE FROM EACH STRING
	CAIL T3,"A"+40		;LC LETTER?
	JRST [	CAIG T3,"Z"+40
		SUBI T3,40	;YES, CONVERT TO UC
		JRST .+1]
	XCTBU [ILDB T4,T2]
	CAIL T4,"A"+40		;LC LETTER?
	JRST [	CAIG T4,"Z"+40
		SUBI T4,40	;YES, CONVERT TO UC
		JRST .+1]
	CAME T3,T4		;STILL EQUAL?
	JRST STRC2		;NO, GO SEE WHY
	JUMPN T3,USTCMP		;KEEP GOING IF NOT END OF STRING
	SETZ T1,		;STRINGS ENDED TOGETHER, EXACT MATCH.
	RET			;RETURN 0

STRC2:	JUMPE T3,[MOVX T1,SC%SUB ;TEST STRING ENDED, IS A SUBSET
		ADD T2,[7B5]	;DECREMENT BASE POINTER ONE BYTE
		RET]
	CAMG T3,T4		;STRINGS UNEQUAL
	SKIPA T1,[SC%LSS]	;TEST STRING LESS
	MOVX T1,SC%GTR		;TEST STRING GREATER
	RET

;KEYWORD TABLE ROUTINES.

;THESE ROUTINES PERFORM FUNCTIONS ON KEYWORD TABLES IN STANDARD
;FORMAT.  A KEYWORD TABLE IS ONE DESIGNED TO ALLOW ABBREVIATION
;RECOGNITION AND COMPLETION FOLLOWING THE USUAL CONVENTIONS.

;THE TABLE FORMAT IS:

;	TABLE:	# OF ENTRIES IN USE, MAX SIZE OF TABLE
;		XWD ADR OF STRING, ANYTHING
;		 ..
;		 ..

;THE TABLE MUST BE SORTED BY STRINGS SO THAT BINARY SEARCHING
;AND AMBIGUITY DETERMINATION MAY BE DONE EFFICIENTLY.

;THE RIGHT HALF OF EACH ENTRY CAN BE THE DATA FOR THE ENTRY OR
;A POINTER TO ADDITIONAL INFORMATION.  THESE ROUTINES IGNORE IT.

;**************************************************************

;TBDEL - DELETE AN ENTRY FROM STANDARD KEYWORD TABLE
; T1/ ADDRESS OF TABLE HEADER WORD
; T2/ ADDRESS OF ENTRY TO BE DELETED (AS RETURNED BY LOOKUP)
;	TDEL
; RETURN +1 ALWAYS, ITRAP IF TABLE EMPTY

.TBDEL::MCENT
	CALL XTDEL		;DO THE WORK
	 ITERR ()
	MRETNG

;THIS IS THE WORKER ROUTINE.  IT MAY BE CALLED INTERNALLY, AND
;IT REFERENCES PREVIOUS CONTEXT FOR ALL ARGUMENT DATA.
; RETURNS +1 FAILURE, ERROR CODE IN T1
; RETURNS +2 SUCCESS

XTDEL::	XCTUM [HLRZ T4,0(T1)]	;GET USED COUNT
	MOVE T3,T4
	SOSGE T3		;REDUCE COUNT, TABLE ALREADY EMPTY?
	RETBAD TDELX1		;YES
	ADD T4,T1		;COMPUTE END OF TABLE
	CAILE T2,(T1)
	CAMLE T2,T4		;DELETED ENTRY WITHIN TABLE?
	RETBAD TDELX2		;NO
	XCT 5,[HRLM T3,0(T1)]	;YES, STORE DECREMENTED COUNT
	JUMPE T3,TDELZ		;JUMP IF TABLE NOW EMPTY
	HRLI T2,1(T2)		;COMPACT TABLE, FROM DELETED ENTRY +1
	XBLTUU [BLT T2,-1(T4)]	;TO DELETED ENTRY UNTIL END
TDELZ:	XCTMU [SETZM 0(T4)]	;CLEAR EMPTY WORD AT END OF TABLE
	RETSKP

;TBADD - ADD ENTRY TO STANDARD KEYWORD TABLE
; T1/ ADDRESS OF TABLE HEADER WORD
; T2/ ENTRY TO BE ADDED
;	TADD
; RETURN +1 ALWAYS, ITRAP IF TABLE FULL OR BAD FORMAT
;  T1/ ADDRESS OF NEW ENTRY

.TBADD::MCENT
	CALL XTADD		;DO THE WORK
	 ITERR ()
	UMOVEM T1,T1
	MRETNG

;WORKER ROUTINE - MAY BE CALLED INTERNALLY. REFERENCES PREVIOUS CONTEXT.
; RETURN +1 FAILURE, TABLE FULL OR BAD FORMAT
; RETURN +2 SUCCESS

XTADD:	ASUBR <TBA,ENT>
	HLRZ T2,T2		;CONSTRUCT STRING PTR TO NEW STRING
	CALL CHKTBS		;GET POINTER TO ACTUAL STRING
	MOVE T1,TBA		;GET TABLE ADDRESS
	CALL XTLOOK		;FIND PLACE FOR NEW ENTRY
	 RETBAD()		;BAD FORMAT TABLE
	TXNE T2,TL%EXM		;EXACT MATCH?
	RETBAD TADDX2		;YES, ENTRY ALREADY IN TABLE

; T1/ ADDRESS WHERE ENTRY SHOULD BE PUT

	MOVE T2,TBA		;GET TABLE ADDRESS
	XCTUM [HLRZ T4,0(T2)]	;INCREMENT NUMBER ENTRIES IN USE
	AOS T4
	XCTUM [HRRZ T3,0(T2)]	;GET TABLE SIZE
	CAMLE T4,T3
	RETBAD TADDX1		;TABLE FULL
	XCT 5,[HRLM T4,0(T2)]	;UPDATE ENTRY COUNT
	ADD T4,T2		;COMPUTE NEW END OF TABLE
XTADD2:	CAML T1,T4		;NOW AT 'HOLE'?
	JRST [	MOVE T3,ENT	;YES, INSERT ENTRY
		UMOVEM T3,0(T1)
		RETSKP]
	XCTUM [MOVE T3,-1(T4)]	;MOVE TABLE TO CREATE HOLE
	XCTMU [MOVEM T3,0(T4)]
	SOJA T4,XTADD2

;TBLUK - LOOKUP ENTRY IN STANDARD KEYWORD TABLE
; T1/ ADDRESS OF TABLE HEADER WORD
; T2/ STRING POINTER TO STRING TO BE FOUND
;	TLOOK
; RETURNS +1 ALWAYS, ITERR IF BAD TABLE FORMAT
;  T1/ ADDRESS OF ENTRY WHICH MATCHED OR WHERE ENTRY WOULD BE
;	IF IT WERE IN TABLE
;  T2/ RECOGNITION CODE:
;	1B0 (TL%NOM) - NO MATCH
;	1B1 (TL%AMB) - AMBIGUOUS
;	1B2 (TL%ABR) - UNIQUE ABBREVIATION
;	1B3 (TL%EXM) - EXACT MATCH
;  T3/ POINTER TO REMAINDER OF STRING IN TABLE IF MATCH
;	WAS AN ABBREVIATION.  THIS STRING MAY BE TYPED OUT TO
;	COMPLETE THE KEYWORD.

.TBLUK::MCENT
	CALL XTLOK0		;DO THE WORK
	 ITERR ()
	UMOVEM T1,T1		;STORE RESULTS
	UMOVEM T2,T2
	UMOVEM T3,T3
	MRETNG

;WORKER ROUTINE - MAY BE CALLED INTERNALLY. REFERENCES PREVIOUS CONTEXT.
; RETURNS +1 FAILURE, BAD TABLE FORMAT
; RETURNS +2 SUCCESS, ACS AS ABOVE

;INTERNAL AC USAGE:
; T1/ TEST STRING FROM CALL
; T2/ STRING FROM TABLE
; T3/ CLOBBERED BY USTCMP
; T4/ " "
; P1/ CURRENT TABLE INDEX
; P2/ ADDRESS OF TABLE INDEXED BY P1 - USED FOR INDIRECTION
; P3/ INDEX INCREMENT FOR LOG SEARCH
; P4/ SIZE OF TABLE

XTLOOK::SAVEP			;PRESERVE ACS
XTLOK0:	ASUBR <TBA,STRG,REMSTR>	;JSYS ENTRY, NO NEED TO PRESERVE ACS
	HLRZ T3,T2		;CHECK STRING POINTER
	CAIE T3,-1		;LH 0 OR -1?
	CAIN T3,0
	HRLI T2,(POINT 7,0)	;YES, FILL IN
	MOVEM T2,STRG
	MOVEI P2,1(T1)		;CONSTRUCT ADDRESS OF FIRST ENTRY
	HRLI P2,P1		;MAKE IT INDEXED BY P1
	XCTUM [HLRZ P4,0(T1)]	;GET PRESENT SIZE
	MOVE P3,P4		;INITIAL INCREMENT IS SIZE
	MOVE P1,P4		;SET INITIAL INDEX TO SIZE/2
	ASH P1,-1
	JUMPE P4,TABLKX		;IF TABLE EMPTY THEN NO MATCH
TABLK0:	XCTUM [HLRZ T2,@P2]	;GET STRING ADR FROM TABLE
	CALL CHKTBS		;CONSTRUCT POINTER
	MOVE T1,STRG		;GET TEST STRING
	CALL USTCMP		;COMPARE
	JUMPN T1,TABLK1		;JUMP IF NOT EXACTLY EQUAL
TABLKF:	XCTUM [HLRZ T2,@P2]	;GET STRING ADDRESS
	CALL CHKTBS		;GET FLAGS
	JXN T1,CM%NOR,TABLKM	;MAKE IT AMBIG IF NOREC ENTRY
	MOVX T2,TL%EXM		;EXACTLY EQUAL, RETURN CODE
	JRST TABLKA

TABLKM:	SKIPA T2,[TL%AMB]	;AMBIGUOUS RETURN
TABLKX:	MOVX T2,TL%NOM		;NO MATCH RETURN
TABLKA:	MOVEI T1,@P2		;RETURN ADR WHERE ENTRY IS OR SHOULD BE
	RETSKP

;STRING MAY BE UNEQUAL OR A SUBSET, SEE WHICH

TABLK1:	JXE T1,SC%SUB,TABLKN	;UNEQUAL, GO SETUP NEXT PROBE
TABLK3:	MOVEM T2,REMSTR		;SUBSTRING, SAVE REMAINDER
	JUMPE P1,TABLK2		;JUMP IF THIS FIRST ENTRY IN TABLE
	MOVEI T1,@P2		;CHECK NEXT HIGHER ENTRY IN TABLE
	XCTUM [HLRZ T2,-1(T1)]	;GET ITS STRING ADDRESS
	CALL CHKTBS		;BUILD BYTE PTR
	MOVE T1,STRG		;GET TEST STRING
	CALL USTCMP		;TEST PREVIOUS ENTRY
	JUMPE T1,[SOJA P1,TABLKF] ;EXACTLY EQUAL, DONE. FIX INDEX.
	JXN T1,SC%GTR,TABLK2	;IF LESS THEN HAVE FOUND HIGHEST SUBSTR
	SOJA P1,TABLK3		;STILL A SUBSTR, CHECK HIGHER

;NOW POINT AT HIGHEST ENTRY WHICH IS A SUBSTR.  IF THERE IS AN EXACT
;MATCH, IT IS BEFORE ALL SUBSETS AND HAS ALREADY BEEN FOUND

TABLK2:	MOVEI T1,@P2		;CHECK NEXT ENTRY FOR AMBIGUOUS
	CAIL P1,-1(P4)		;NOW AT LAST ENTRY IN TABLE?
	JRST TBLK2A		;YES, THIS ENTRY IS DISTINCT
	XCTUM [HLRZ T2,1(T1)]	;GET STRING ADR OF NEXT ENTRY
	CALL CHKTBS		;BUILD BYTE PTR
	MOVE T1,STRG		;GET TEST STRING
	CALL USTCMP		;COMPARE NEXT LOWER ENTRY
	JUMPE T1,[RETBAD TLUKX1] ;EXACT MATCH, TABLE MUST BE BAD
	JXN T1,SC%SUB,TABLKM	;NEXT ENTRY NOT DISTINCT, DO AMBIG RETURN
TBLK2A:	XCTUM [HLRZ T2,@P2]	;CHECK FLAGS FOR THIS ENTRY
	CALL CHKTBS
	JXN T1,CM%NOR,TABLKM	;FAIL IF NOREC BIT SET
	MOVX T2,TL%ABR		;GIVE LEGAL ABBREVIATION RETURN
	MOVE T3,REMSTR		;RETURN PTR TO REMAINDER OF STRING
	JRST TABLKA

;HERE WHEN PROBE NOT EQUAL

TABLKN:	CAIG P3,1		;INCREMENT NOW 1?
	JRST [	JXN T1,SC%LSS,TABLKX ;YES, NO MATCH FOUND
		AOJA P1,TABLKX]	;IF STRING GREATER, BUMP ADR FOR INSERT
	AOS P3			;NEXT INC = <INC+1>/2
	ASH P3,-1
	TXNE T1,SC%GTR		;IF LAST PROBE LOW, ADD INCREMENT
	ADD P1,P3
	TXNE T1,SC%LSS
	SUB P1,P3		;LAST PROBE HIGH, SUBTRACT INCR
TBLKN1:	CAIL P1,0(P4)		;AFTER END OF TABLE?
	JRST [	MOVX T1,SC%LSS	;YES, FAKE PROBE TOO HIGH
		JRST TABLKN]
	JUMPGE P1,TABLK0	;IF STILL WITHIN TABLE RANGE, GO PROBE
	MOVX T1,SC%GTR		;BEFORE START OF TABLE, FAKE LOW PROBE
	JRST TABLKN

;SIMULATE RCUSR AND RCDIR FOR SIMPLE (NON-STEPPING) CASES
.RCUSR::MCENT
	CALL RCDIR0		;GET USER OR DIRECTORY
	 TXO T1,RC%NOM		;A FILES ONLY DIRECTORY WHEN ASKED FOR A USER
	JRST RCDIRR		;RETURN TO USER

.RCDIR::MCENT
	CALL RCDIR0
	 JFCL
RCDIRR:	UMOVEM T1,1		;RETURN FLAGS
	MRETNG

RCDIR0:	SETZ T1,		;USE DEFAULT DEVICE
	PUSHJ P,SETUNT
	 JRST MRTNE1
	UMOVE T1,2		; STRING POINTER FROM USER
	PUSHJ P,CPYFUS
	 JRST MRTNE1
	PUSH P,[MAXLC]		; Save place for FILCNT (FILOPT-FILCNT=2)
	PUSH P,T1		; Save location of the temp block
	PUSH P,T2		; Save string pointer to tail
	MOVNI JFN,FILOPT	; Gotta do it the hard way
	ADD JFN,P
	HRRZS JFN
	XCTUU [	TLNN T1,(RC%EMO)] ;ONLY EXACT MATCH?
	 TEST(OA,NREC)
	 TEST(Z,NREC)
	PUSHJ P,DIRLUK
	 JRST [	MOVX T1,RC%NOM
		JRST RCDIR1]
	 JRST [	MOVX T1,RC%AMB
		JRST RCDIR1]
	UMOVEM T1,3		;RETURN DIRECTORY NUMBER
	XCTUU [	TLNE T1,(RC%EMO)]
	 JRST RCDIR4		;NO RECOGNITION
	UMOVE T1,2		; Get the user's pointer
	MOVE T2,-1(P)		; Get temp block location
	PUSHJ P,CPYTUS
	MOVEM T2,(P)
RCDIR4:	UMOVE T1,3		; Get the directory number back
	PUSHJ P,GETDDB
	 BUG(HLT,<STDIR: GETDDB FAILED WHEN DIRLUK DIDN'T.>)
	SKIPL T1,DDBMOD(T1)	;FILES ONLY?
	 AOS -3(P)		;NO, SKIP RETURN WHEN DONE
	TLNN T1,(1B2)		;REPEAT LOGIN MESSAGES?
	 TDZA T1,T1		;NO, NO FLAGS THEN
	 MOVX T1,RC%RLM
	MOVEM T1,-2(P)
	PUSHJ P,USTDIR
	SKIPA
RCDIR1:  MOVEM T1,-2(P)
	POP P,T2
	UMOVEM T2,2		;UPDATED STRING POINTER
	POP P,T2		; Recover temp block location
	MOVEI T1,JSBFRE
	CALL RELFRE
	POP P,T1		;GET FLAGS
	RET

;GET JOB INFORMATION
; 1/ JOB #, OR -1 FOR SELF, OR TTY # + 400000
; 2/ -N,,USER ADR
; 3/ FIRST ENTRY DESIRED
;	GETJI
; RETURN +1: FAILURE
; RETURN +2: SUCCESS, ENTRIES STORED IN USER ARRAY
;REQUIRES GETAB CAPABILITY IF JOB OTHER THAN SELF

.GETJI::MCENT
	UMOVE P2,3		;GET NUMBER OF FIRST ENTRY DESIRED
	HRL P2,P2		;DUPLICATE IN BOTH HAVLES
	JUMPL P2,[RETERR (GTJIX1)] ;INSURE NOT NEGATIVE
	ADD P2,[-NGTJIT,,0]	;SETUP AOBJN PTR TO FIRST ENTRY
	JUMPGE P2,[RETERR (GTJIX1)] ;ALREADY BEYOND END OF TABLE
	UMOVE P3,2		;GET USER 'S ADR POINTER
	CAMN 1,[-1]		;SELF?
	JRST [	MOVE 1,JOBNO	;YES, GET THIS JOB NUMBER
		JRST GETJI5]	;SKIP CAPABILITY CHECK
	MOVX 2,SC%GTB
	TDNN 2,CAPMSK		;HAS GETAB CAPABILITY?
	RETERR (GTABX3)		;NO
	TRZE 1,400000		;TTY DESIGNATOR?
	JRST [	CAIL 1,0	;YES, LEGAL LINE NUMBER?
		CAIL 1,NLINES
		RETERR (GTJIX2)	;NO
		HLR T3,TTFORK(T1) ;OWNING JOB
		CAIN T3,-1	;IS THERE AN OWNING JOB?
		 JRST GETJI6	;NO.
		MOVE T2,T3	;YES. PRESERVE JOB NUMBER
		HLRZ T3,JOBPT(T2) ;GET CONTROLLING TTY FOR JOB
		CAME 3,1	;SAME AS GIVEN TTY?
		JRST GETJI1	;NO, TTY IS ASSIGNED NOT CONTROLLING
		MOVE 1,2	;SETUP JOB NUMBER
		JRST .+1]	;CONTINUE WITH JOB NUMBER
	CAIL 1,0		;LEGAL JOB NUMBER?
	CAIL 1,NJOBS
	RETERR (GTJIX3)		;NO
GETJI5:	NOSKED			;DON'T ALLOW JOB TO LOG OUT
	SKIPGE JOBRT(T1)	;JOB EXISTS?
	RETERR (GTJIX4,<OKSKED>) ;NO. GIVE APPROPRIATE ERROR
	MOVEM 1,P1		;SAVE JOB NUMBER
	MOVEM T1,P4		;SAVE JSB OFFSET
GETJI2:	XCT GETJIT(P2)		;GET ITEM
	 UMOVEM 1,0(P3)		;GIVE IT TO USER (ROUTINES THAT SKIP HAVE ALREADY DONE THIS)
	AOBJP P3,GETJI3		;COUNT USER'S COUNT AND ADR
	AOBJN P2,GETJI2		;COUNT OUR COUNT AND ADR
GETJI3:	OKSKED			;OK TO ALLOW SCHEDULING. JOB CAN'T LOGOUT
				; SINCE ITS JSB IS MAPPED
GETJIX:	UMOVEM P3,2		;UPDATE USERS PTR
	SMRETN

;GETJI...
;HERE IF TTY GIVEN AND NO CONTROLLING JOB
;GETJI6 - NO JOB OWNS THIS TERMINAL; GETJI1 - A JOB OWNS THIS TERMINAL
;BUT IT IS NOT THE JOB'S CONTROLLING TERMINAL

GETJI6:	SETOM T2		;INDICATE NO OWNING JOB
	SKIPA
GETJI1:	TLO 2,(1B1)		;SAY ASSIGNED
GETJI4:	XCTUU [SKIPE 3]		;DOES USER WANT FIRST ENTRY?
	JRST GETJIX		;NO, NOTHING TO DO
	UMOVEM 2,0(P3)		;YES, STORE IT
	AOBJN P3,.+1		;UPDATE HIS POINTER
	JRST GETJIX		;RETURN

;TABLE OF GETJI ITEMS - WORD IS EXECUTED TO GET ITEM IN AC1

GETJIT:	MOVE 1,P1		;JOB NUMBER
	HLRE 1,JOBPT(P1)	;TTY NUMBER OR -1 IF DETACHED
	HRRZ 1,JOBDIR(P1)	;GET LOGIN DIRECTORY NUMBER
	HLRZ 1,JOBDIR(P1)	;GET CONNECTED DIRECTORY
	CALL GETSN1		;SUBSYSTEM NAME
	MOVE 1,JOBNM2(P1)	;PROGRAM NAME
	MOVE 1,JOBRT(P1)	;RUN TIME
NGTJIT==.-GETJIT

;GET SUBSYSTEM NAME

GETSN1:	HRRZ 1,JOBNAM(P1)	;GET STATISTICS INDEX
	MOVE 1,SNAMES(1)	;GET NAME
	RET

; READ FILE TIME AND DATE
; CALL:	1	;JFN
;	2	;ADDR
;	3	;COUNT
;	RFTAD
; RETURNS
;	+1	; ERROR, CODE IN 1
;	+2	; SUCCESS
; WITH:	1	; UNCHANGED
;	2	; UNCHANGED
; ADDR +0	;TIME AND DATE OF CREATION
; ADDR +1	;TIME AND DATE OF LAST WRITE
; ADDR +2	;TIME AND DATE OF LAST READ
; ADDR +3	;MONITOR LAST WRITE TIME AND DATE (PRIVILEGED)
;	FIRST "COUNT" LOCATIONS OF "ADDR" FILLED WITH DATES
;	ANY WORDS OF "ADDR" FOR WHICH NO DATE EXISTS ARE FILLED WITH -1

.RFTAD::MCENT
	MOVE JFN,1
	CALL CHKJFN
	 ITERR()
	 JFCL
	 JFCL
	UMOVE A,3		;GET COUNT
	JUMPE A,RFTAD1		;RETURN NOW IF 0 COUNT
	UMOVE Q3,2		;GET ADDR
	ADDI A,-1(Q3)		;CALC END ADDR
	MOVSI B,(Q3)
	HRRI B,1(Q3)		;MAKE BLT POINTER
	XCTUU [SETOM (Q3)]	;INITIALIZE TABLE TO -1
	UMOVE Q1,3		;GET COUNT AGAIN FOR SUBR
	CAIE Q1,1		;DONE IF ONLY 1 WORD BUFFER
	XBLTUU [BLT B,(A)]	;FILL IT
	CAIE DEV,DSKDTB		;A DISK FILE?
	 JRST RFTAD1
	CALL DSKRFT
	 ITERR(,<CALL UNLCKF>)	;ERROR
RFTAD1:	CALL UNLCKF
	MRETNG

; SET FILE TIME AND DATE
; CALL:	1	;JFN
;	2	;ADDR
;	3	;COUNT
; ADDR +0	;TIME AND DATE OF CREATION
; ADDR +1	;TIME AND DATE OF LAST WRITE
; ADDR +2	;TIME AND DATE OF LAST READ
; ADDR +3	;MONITOR LAST WRITE TIME AND DATE (PRIVILEGED)
;		; TIME AND DATE = -1 FOR NO CHANGE
;	SFTAD
; RETURNS
;	+1	; ERROR, CODE IN 1
;	+2	; SUCCESS

.SFTAD::MCENT
	MOVE JFN,1
	CALL CHKJFN
	 ITERR()
	 JFCL
	 JFCL
	UMOVE Q1,3		;GET COUNT FOR SUBRS
	JUMPE Q1,SFTAD1		;JUST RETURN IF COUNT = 0
	UMOVE Q3,2		;GET ADDR
	MOVE T1,CAPENB		;CHECK DATES?
	TRNE T1,SC%WHL!SC%OPR	;WHEEL OR OPERATOR?
	JRST SFTAD2		;CAN SET ANYTHING
	GTAD
	JUMPL A,[ITERR(DATEX6,<CALL UNLCKF>)] ;LOSE IF NOT SET
	MOVN B,Q1		;GET - LENGTH
	HRLZ B,B
	HRR B,Q3		;AND TABLE ADDR
SFTAD3:	XCTUM [MOVE C,(B)]	;GET ENTRY
	CAME C,[-1]		;NOT CHANGING,
	CAMG C,A		;OR LEGAL TIME AND DATE?
	AOBJN B,SFTAD3		;YES, GET NEXT
	JUMPGE B,SFTAD2		;  Checked all entries
	ITERR(DATEX6,<CALL UNLCKF>) ;ILLEGAL TIME AND DATE?
	AOBJN B,SFTAD3		; Do all entries
SFTAD2:	CAIE DEV,DSKDTB
	 JRST SFTAD1
	CALL DSKRFT
	 ITERR(,<CALL UNLCKF>)	;ERROR
SFTAD1:	CALL UNLCKF
	MRETNG

;RFTAD/SFTAD DEVICE ROUTINES FOR DISK

;RFTAD
DSKRFT:	TQNE <ASTF>		;OUTPUT STARS?
	RETBAD(DESX7)		;YES, LOSE
	CALL GETFDB		;GET FDB IN
	 RETBAD(DESX3)		;LOSE
	MOVE B,FDBCRV(A)	;GET CREATION DATE AND TIME
	CAILE Q1,.RSCRV		;DOES CREATION WORD EXIST?
	XCTMU [MOVEM B,.RSCRV(Q3)] ;YES, RETURN TO USER
	MOVE B,FDBWRT(A)	;GET WRITTEN DATE AND TIME
	CAILE Q1,.RSWRT		;DOES WRITTEN WORD EXIST?
	XCTMU [MOVEM B,.RSWRT(Q3)] ;YES, RETURN TO USER
	MOVE B,FDBREF(A)	;GET REFERENCE DATE AND TIME
	CAILE Q1,.RSREF		;DOES REFERENCE WORD EXIST?
	XCTMU [MOVEM B,.RSREF(Q3)] ;YES, RETURN TO USER
	MOVE B,FDBCRE(A)	;GET INTERNAL WRITTEN DATE AND TIME
	CAILE Q1,.RSCRE		;DOES INTERNAL SYSTEM WRITTEN WORD EXIST?
	XCTMU [MOVEM B,.RSCRE(Q3)] ;YES, RETURN TO USER
	CALL USTDIR
	RETSKP

;SFTAD
DSKSFT:	STKVAR <FDBSAV>
	TQNE <ASTF>
	 RETBAD(DESX7)
	MOVNI A,1
	MOVN B,Q1
	HRLZ B,B
	HRR B,Q3
DSKSF0:	XCTUU [CAMN A,(B)]
	 AOBJN B,DSKSF0
	JUMPGE B,RSKP		;NOOP IF ALL -1
	CALL GETFDB		;GET FDB IN
	 RETBAD(DESX3)
	MOVEM A,FDBSAV
	MOVE B,CAPENB		;GET CAPABILITIES
	TQNN WRTF		;ALWAYS SUCCEED IF OPEN FOR WRITE
	 TXNE B,SC%WHL!SC%OPR	; Wheels always win
	 JRST DSKSF1		;CAN CHANGE ANYTHING
DSKSF4:	HRLI A,WRTF		;CHECK WRITE ACCESS
	CALL ACCCHK		;CHECK FOR WRITE ACCESS TO THIS FILE
	 JRST DSKSF2		;CHECK FOR OWNER
	JRST DSKSF1

DSKSF2:	MOVSI A,XCTF
	CALL DIRCHK		;CHECK FOR ABILITY TO CONNECT TO 
				; THIS DIRECTORY (AND THUS BECOME LIKE OWNER)
	 RETBAD (CFDBX2,<CALL USTDIR>)
DSKSF1:	MOVE A,FDBSAV
	CAIG Q1,.RSCRV
	JRST DSKSF5
	XCTUM [MOVE B,.RSCRV(Q3)]
	CAME B,[-1]
	MOVEM B,FDBCRV(A)	;CREATION DATE AND TIME
DSKSF5:	CAIG Q1,.RSWRT
	JRST DSKSF6
	XCTUM [MOVE B,.RSWRT(Q3)]
	CAME B,[-1]
	MOVEM B,FDBWRT(A)	;WRITE DATE AND TIME
DSKSF6:	CAIG Q1,.RSREF
	JRST DSKSF7
	XCTUM [MOVE B,.RSREF(Q3)]
	CAME B,[-1]
	MOVEM B,FDBREF(A)	;READ DATE AND TIME
DSKSF7:	CAIG Q1,.RSCRE
	JRST DSKSF8
	XCTUM [MOVE B,.RSCRE(Q3)]
	CAMN B,[-1]
	JRST DSKSF8		; Doesn't wish to change it
	MOVX C,SC%WHL!SC%OPR
	TDNE C,CAPENB		; Caller allowed?
	MOVEM B,FDBCRE(A)	; Yes, store internal write d&t
DSKSF8:	CALL USTDIR
	RETSKP

; GET FILE USER STRING
;
; CALL:	1/ FUNCTION ,, JFN
;	2/ DESTINATION POINTER
;		GFUST
; RETURNS: +1 ALWAYS, DESTINATION POINTER UPDATED

.GFUST::MCENT			;MONITOR CONTEXT ENTRY

; CHECK FUNCTION CODE

	XCTUM [HLRZ T3,1]	;GET FUNCTION CODE FROM USER
	CAIE T3,.GFAUT		;IS FUNCTION "GET AUTHOR" ?
	CAIN T3,.GFLWR		;  OR "GET LAST WRITER" ?
	SKIPA			;YES, EVERYTHING KOSHER
	ITERR (GFUSX1)		;NO, REFUSE TO PROVIDE FURTHER SERVICE

; GET DIRECTORY NUMBERS FROM FDB

	XCTUM [HRRZ JFN,1]	;GET JFN FROM USER
	CALL CHKJFN		;GRNTEE JFN ON DISK
	 SKIPA
	 JFCL
	 ITERR ()
	CALL GETFDB		;GET FDB ADRS
	 ITERR (GFUSX3,<CALL UNLCKF>)

; TRANSLATE REQUESTED DIRECTORY NUMBER TO STRING

	HLRZ T2,FDBUSE(T1)	;LAST WRITER
	CALL USTDIR		;UNLOCK DIRECTORY
	CALL UNLCKF		;UNLOCK JFN
	JUMPE T2,GFUS20		;NO AUTHOR/LAST-WRITER EXISTS, RETURN A NULL
	MOVE T1,T2
	CALL GDIRST		;TRANSLATE TO STRING
	 JRST [	CAIE T1,DIRX1	; OR INVALID DIRECTORY NUMBER ?
		 ITERR ()	;GIVE ERROR NOTICE TO USER
		SETZ T2,
		JRST GFUS20]	;YES, RETURN A NULL
	MOVE T2,T1		;GET ADDRESS OF BLOCK CONTAINING STRING
GFUS20:	UMOVE T1,2		;GET DESTINATION POINTER
	JUMPE T2,[XCTBU [IDPB T2,T1]
		  JRST GFUS21]
	CALL CPYTUS		;RETURN STRING TO USER
	UNLOCK DIRLCK,,HIQ
GFUS21:	JRST MRETN		;GIVE USER SUCCESS RETURN

; SET FILE USER STRING
;
; CALL: (ARGUMENTS IN USER SPACE)
; ACCEPTS IN T1/ FUNCTION,,JFN
;	     T2/ POINTER TO NAME STRING
;		SFUST
; RETURNS: +1 ALWAYS

.SFUST::MCENT			;MONITOR CONTEXT ENTRY
	TRVAR <SFUBLK,SFUFDA,SFUDIR,SFUERR> ;ALLOCATE LOCAL STORAGE

; VALIDATE THE FUNCTION REQUESTED

	XCTUM [ HLRZ T3,1 ]	;GET FUNCTION CODE FROM USER
	CAIE T3,.SFAUT		;IS FUNCTION "SET AUTHOR STRING" ?
	CAIN T3,.SFLWR		;  OR "SET LAST WRITER" ?
	SKIPA			;YES, PROCEED
	ITERR (SFUSX1)		;NO, RETURN "INVALID FUNCTION" ERROR

; COPY NAME STRING FROM USER AND TRANSLATE TO DIRECTORY NUMBER

	UMOVE T1,2		;GET POINTER TO NAME STRING IN USER SPACE
	CALL CPYFUS		;COPY STRING FROM USER SPACE
	 ITERR (SFUSX2)		;FAILED, RETURN "INSUFFICIENT RESOURCES" ERROR
	MOVEM T1,SFUBLK		;SAVE ADDRESS OF BLOCK ASSIGNED
	XCTUM [HRRZ JFN,1]	;GET JFN
	CALL CHKJFN		;VALIDATE FOR FILE ONLY
	 SKIPA
	 JFCL
	 ITERR (,<MOVEM T1,SFUERR	;SAVE THE ERROR CODE
		CALL SFUX2
		MOVE T1,SFUERR>)
	CALL GETFDB		;GET FDB MAPPED
	 ITERR (SFUSX4,<CALL SFUX1>)
	MOVEM T1,SFUFDA		;SAVE FDB ADDRESS
	XCTUM [HLRZ T3,1]	;GET FCN CODE AGAIN
	MOVE T2,CAPENB		;CHECK IF ENABLED
	TXNE T2,SC%WHL!SC%OPR
	JRST SFUSOK		;OK TO PROCEED
	CAIN T3,.SFLWR		;WANT TO SET LAST-WRITER?
	ITERR (CAPX1,<CALL SFUXIT>) ;NEED TO BE WHOPER
	MOVSI T1,XCTF		;ELSE OWNER PRIVS FOR AUTHOR
	CALL DIRCHK		; STRING SETTING
	 ITERR (SFUSX5,<CALL SFUXIT>)
SFUSOK:	MOVE T1,SFUFDA		;GET FDB ADDRS AGAIN
	CALL USTDIR		;FIRST UNLOCK DIRECTORY
	MOVE T1,SFUBLK		;POINT TO STRING
	MOVEI T3,0		;DON'T NEED THIS IF NO RECOG.
	TQO <NREC>		;SAY DON'T RECOGNIZE
	CALL DIRLUK		;SEE IF VALID USER NAME
	 JFCL
	 ITERR (SFUSX6,<CALL SFUX1>) ; NO SUCH USER
	MOVEM T1,SFUDIR		;SAVE DIRECTORY NUMBER
	CALL GETFDB		;GET FDB AGAIN
	 ITERR (SFUSX4,<CALL SFUX1>) ;FILE DISAPPEARED
	HRRZ T2,SFUDIR		;GET DIRECTORY NUMBER
	HRLM T2,FDBUSE(T1)
	CALL SFUXIT		;UNLOCK EVERYTHING
	JRST MRETN		;AND RETURN

;COMMON EXIT (CLEANUP) ROUTINES

SFUXIT:	CALL USTDIR		;UNLOCK DIRECTORY
SFUX1:	CALL UNLCKF		;UNLOCK JFN
SFUX2:	MOVEI T1,JSBFRE		;FREE UP JSB FREE SPACE
	MOVE T2,SFUBLK		;...
	CALL RELFRE
	OKINT			;ALLOW INTS AGAIN
	RET			;RETURN

;;; SNOOP - FOR NOW JUST SYMBOL LOOKUP
.SNOOP::MCENT
	MOVE T2,CAPENB
	TRNN T2,SC%WHL!SC%OPR
	 RETERR (SNOPX1)
	XCTUM [HRRZ T1,1]	;GET FUNCTION CODE
	CAIE T1,.SNPSY		;IS THIS A SYMBOL LOOKUP?
	 RETERR (SNOPX2)	;NO, FOR NOW THAT IS ALL WE SUPPORT
	SKIPL P1,.JBSYM##
	 RETERR (SNOP14)
	UMOVE T3,3		;GET DESIRED BLOCK
	JUMPE T3,SNOOP2		;NONE NEEDED
	HLRE T1,P1		;GET LENGTH OF SYMBOL TABLE
	MOVMS T1
	ADDI T1,-2(P1)		;COMPUTE ADDRESS OF LAST PROGRAM NAME
SNOOP1:	CAIG T1,(P1)		;STILL INSIDE SYMBOL TABLE?
	 RETERR (SNOP13)	;NO, NO SUCH PROGRAM NAME
	MOVE T2,(T1)		;GET PROGRAM NAME
	TLNE T2,740000		;LOOKS LIKE ONE?
	 RETERR (SNOP14)	;NO, MUST BE FUCKED
	HLRE T4,1(T1)		;AND LENGTH OF IT
	ADD T1,T4		;MOVE BACK TO PREVIOUS PROGRAM
	CAME T2,T3		;THE ONE WE WANT?
	 JRST SNOOP1		;NO, KEEP LOOKING
	HRRI P1,(T1)
	HRL P1,T4		;NOW HAVE POINTER FOR LOCAL SEARCH

;; P1 - SYMBOL TABLE POINTER
;; P2 - DESIRED SYMBOL
;; Q1 - MATCH FOUND
;; Q2 - COUNT OF FOUND

SNOOP2:	UMOVE T2,2		;GET SYMBOL USER WANTS
	SETO Q2,		;NONE FOUND YET
SNOP21:	MOVE T1,(P1)
	TLZE T1,740000		;DON'T BE CONFUSED BY PROGRAM NAME
	 CAME T1,T2		;THE SAME?
	 JRST SNOP22		;NO, TRY NEXT
	MOVE Q1,1(P1)		;SAVE VALUE FOR LATER
	AOSE Q2
	 RETERR (SNOP16)
SNOP22:	AOBJP P1,.+1
	AOBJN P1,SNOP21
	SKIPE Q2
	 RETERR (SNOP14)	;NOT FOUND
	UMOVEM Q1,2		;RETURN VALUE
	JRST SKMRTN##		;SKIP RETURN

	RESCD
; XBLTA SIMULATE AN XBLT 1
;
; CALLING SEQENCE:
;
;	T1	LENGTH TO BLT
;	T2	FROM ADDRESS
;	T3	TO ADDRESS
;	CALL XBLTA
;RETURNS +1 ALWAYS
; PRESERVES T4 AND DESTROYS T1,T2,T3
;

XBLTA::	HRRZS T1		;MAKE SURE REASONABLE SIZE
	ADD T1,T3		;NO -- FAKE IT AND DO BLT
	SOS T1
	HRRZS T1
	HRL T3,T2
	BLT T3,0(T1)
	RET

;EXTENDED BLT MONITOR TO USER FOR EXTENDED ADDRESSING
;
; CALLING SEQUENCE:
;
;	T1	LENGTH TO BLT
;	T2	FROM ADDRESS
;	T3	TO ADDRESS
;	CALL BLTMU
;		OR
;	CALL BLTMU1

;RETURNS +1 ALWAYS
; PRESERVES T4 ALTERS T1,T2,T3

BLTMU1::
BLTMU::	HRRZS T1		;MAKE SURE RATIONAL SIZE
	ADD T1,T3		;SIMULATE XBLT
	SOS T1
	HRRZS T1
	HRL T3,T2
	XBLTMU [BLT T3,0(T1)]
	RET

; BLTUM -- EXTENDED BLT FROM USER TO MONITOR SPACE

;
; CALLING SEQUENCE:
;
;	T1 -- COUNT OF WORDS TO TRANSFER
;	T2 -- FROM ADDRESS
;	T3 -- TO ADDRESS
;	CALL BLTUM
;RETURNS +1 ALWAYS AND PRESERVES T4 ALTERS T1,T2,T3
;

BLTUM1::
BLTUM::	HRRZS T1		;MAKE SURE COUNT IS REASONABLE
	ADD T1,T3		;SIMULATE XBLT
	SOS T1
	HRRZS T1
	HRL T3,T2
	XBLTUM [BLT T3,0(T1)]	;DO THE BLT IN SECTION 0 SPACE
	RET			;RETURN TO CALLER

; BLTUU -- EXTENDED BLT FROM USER TO USER SPACE

;
; CALLING SEQUENCE:
;
;	T1 -- COUNT OF WORDS TO TRANSFER
;	T2 -- FROM ADDRESS
;	T3 -- TO ADDRESS
;	CALL BLTUU
;RETURNS +1 ALWAYS AND PRESERVES T4 ALTERS T1,T2,T3
;

BLTUU::	HRRZS T1		;MAKE SURE COUNT IS REASONABLE
	ADD T1,T3		;SIMULATE XBLT
	SOS T1
	HRRZS T1
	HRL T3,T2
	XBLTUU [BLT T3,0(T1)]	;DO THE BLT IN SECTION 0 SPACE
	RET

	END